package NG::Sys::Cached::Base;
use strict;
use warnings;
use utf8;

require NG::Sys::Cached::Common;
our @ISA = qw(NG::Sys::Cached::Common::Parent);

use JSON::XS;
# вызывает make_fields
# создает субкласс и проверяет условия для компиляции методов
sub init {
	my ($self) = @_;
	$self->SUPER::init;
	if($self->make_fields and $self->{blobs}){
		die "cannot blobs without fields\n";
	}
	$self->{record_class} ||= 'NG::Sys::Cached::Base::Record';
	if($self->{subclass}){
		$self->{record_class} = $self->make_subclass($self->{record_class});
	}else{
		if(ref $self->{record_class}){
			die "cannot combine without sublassing";
		}
		if($self->{compile}){
			die "need subclassing for compile";
		}
	}
}
sub need_create {
	return undef;
}
# возврашает true, если нет набора полей
# по умолчанию содает хэш полей и блобов
sub make_fields {
	my ($self) = @_;
	unless($self->{fields}){
		die "need fields\n";
	}
	@{$self->{hash_fields}}{@{$self->{fields}}} = (1) x @{$self->{fields}};
	if($self->{blobs}){
		$self->{hash_blobs} = +{ map {$_=>1} $self->check_fields_ary($self->{blobs}) };
	}
	return 0;
}
# проверяет допустимость данного поля
sub check_field {
	my ($self,$key) = @_;
	return exists $self->{hash_fields}{$key} || die "unexists key'".$key."' checked\n";
}
# проверяет допустимоть списка полей
sub check_fields_ary {
	my ($self,$keys) = @_;
	my $h = $self->{hash_fields};
	exists $h->{$_} || die "unexists key'".$_."' checked\n" for @$keys;
	return @$keys;
}
sub get_obj {
	my ($self,$id,$readonly) = @_;
	die "Bad id='$id'" unless $id and 0 < $id and !ref $id;
	return bless {parent=>$self,id=>$id,readonly => $readonly},$self->{record_class};
}
sub _read_source {
	die "call virtual method '_read_source'\n";
}
sub _update_source {
	die "call virtual method '_update_source'\n";
}
sub _replace_source {
	die "call virtual method '_replace_source'\n";
}
sub _remove_source {
	die "call virtual method '_replace_source'\n";
}
sub _remove_data {
	my ($self,$id) = @_;
	$self->_remove_source($id);
	$self->clear_cache($id);
}
sub _read_data {
	my ($self,$id,$for_store) = @_;
	my $data;
	if($data = $self->context->{$id}){
		$self->count_action("context");
		return $data;
	}
	if($data = $self->{cache}->get($id)){
		$self->count_action("cache");
		if($self->{compress}){
			$data = Compress::Zlib::memGunzip($data);
		}
		$data = decode_json($data);
		$self->context->{$id} = $data unless $for_store;
		return $data;
	}
	if($data = $self->_read_source($id)){
		$self->count_action("source");
		delete $data->{$self->{pkey}} if $self->{pkey};
		unless($for_store){
			if(my $blobs = $self->{blobs}){
				defined $_ and $_ = decode_json($_) for @{$data}{@$blobs};
			}
			my $fdata = encode_json($data);
			if($self->{compress}){
				$fdata = Compress::Zlib::memGzip($fdata);
			}
			$self->{cache}->set($id,$fdata);
			$self->context->{$id} = $data;
		}
		return $data;
	}
	return undef;
}
sub _update_data {
	unshift @_,'_update_source';
	goto &__store_data;
}
sub _replace_data {
	unshift @_,'_replace_source';
	goto &__store_data;
}
sub __store_data {
	my ($method,$self,$id,$data,$keys) = @_;

	my $ndata;
	my $hash_blobs = $self->{hash_blobs};
	if($hash_blobs){
		$ndata = {};
		for(@$keys){
			my $v = $data->{$_};
			$ndata->{$_} = $hash_blobs->{$_} && ref $v ? encode_json($v) : $v;
		}
	}else{
		$ndata = $data;
	}
	my $nkeys = $self->$method($id,$ndata,$keys);

	if($hash_blobs){
		defined $_ and !ref $_ and $_ = decode_json($_) for @{$data}{grep {exists $hash_blobs->{$_}} @$nkeys};
	}
	if(@$nkeys < @$keys){
		my %tmp = map {$_=>1} @$nkeys;
		for(@$keys){
			delete $data->{$_} unless $tmp{$_};
		}
	}
	$self->context->{$id} = $data;
	my $fdata = encode_json($data);
	if($self->{compress}){
		$fdata = Compress::Zlib::memGzip($fdata);
	}
	$self->{cache}->set($id,$fdata);
	
	$self->count_action("store");
	return 1;
}

package NG::Sys::Cached::Base::Record;
use strict;
use warnings;
use utf8;

use NG::Sys::Cached::Common;
our @ISA = qw(NG::Sys::Cached::Common::Child);

sub obj_id {
	my ($self) = @_;
	return $self->{id};
}
sub read_data {
	my ($self,$list) = @_;
	my $data = $self->{parent}->_read_data($self->{id});
	unless(defined $list){
		return $data;
	}elsif(ref $list){
		return @{$data||{}}{$self->{parent}->check_fields_ary($list)};
	}elsif($self->{parent}->check_field($list)){
		return $data && $data->{$list};
	}
}
sub remove {
	my ($self) = @_;
	if($self->{readonly}){
		die "remove readonly data\n";
	}
	my $data = $self->{parent}->_remove_data($self->{id});
}
sub update_data {
	unshift @_,'_update_data';
	goto &__store_data;
}
sub replace_data {
	unshift @_,'_replace_data';
	goto &__store_data;
}
sub __store_data {
	my ($method,$self,@rest) = @_;
	if($self->{readonly}){
		die "save readonly data\n";
	}
	my $sdata;
	if(ref $rest[0]){
		$sdata = $rest[0];
	}else{
		if(@rest % 2){
			die "odd number params\n";
		}
		$sdata = {@rest};
	}
	my $data = $self->{parent}->_read_data($self->{id},1);
	unless($data){
		if($self->{parent}->need_create){
			return undef;
		}else{
			$data = {};
		}
	}
	my @keys = $self->{parent}->check_fields_ary([keys %$sdata]);
	@{$data}{@keys} = @{$sdata}{@keys};
	return $self->{parent}->$method($self->{id},$data,\@keys);
}

our $AUTOLOAD;
sub AUTOLOAD {
	my $self = shift;
	(my $key = $AUTOLOAD) =~ s/.*://;
	
	$self->{parent}->check_field($key);
	
	if($self->{parent}{compile}){
		no strict 'refs';
		my $nc = ref $self;
		*{$AUTOLOAD} = $self->make_compile($key);
		unshift @_,$self;
		goto &{$AUTOLOAD};
	}
	if(@_){
		return $self->update_data($key,@_);
	}else{
		return $self->read_data($key);
	}
}
sub make_compile {
	my ($self,$key) = @_;
	my $parent = $self->{parent};
	return eval "sub {
		my \$self = shift;
		my \$data = \$parent->_read_data(\$self->{id});
		unless(\$data){".(
			$parent->need_create ?
				"return undef;"
			:
				"\$data = {};"
			).
		"}
		if(\@_){
			\$data->{$key} = \$_[0];
			return \$parent->_update_data(\$self->{id},\$data,['$key']);
		}else{
			return \$data->{$key};
		}
	}";
}

1;
